home *** CD-ROM | disk | FTP | other *** search
/ Australian Personal Computer 2002 November / CD 1 / APC0211D1.ISO / workshop / prog / files / ActivePerl-5.6.1.633-MSWin32.msi / _f003cde30874cf0dd5ebb005a7dc1012 < prev    next >
Encoding:
Text File  |  2002-05-30  |  1.5 KB  |  74 lines
  1. # Copyright (c) 1995-1999 Nick Ing-Simmons. All rights reserved.
  2. # This program is free software; you can redistribute it and/or
  3. # modify it under the same terms as Perl itself.
  4. package Tk::Image;
  5.  
  6. # This module does for images what Tk::Widget does for widgets:
  7. # provides a base class for them to inherit from.
  8. require DynaLoader;
  9.  
  10. use base qw(DynaLoader Tk); # but are they ?
  11.  
  12. use vars qw($VERSION);
  13. $VERSION = '3.014'; # $Id: //depot/Tk8/Tk/Image.pm#14 $
  14.  
  15. sub new
  16. {
  17.  my $package = shift;
  18.  my $widget  = shift;
  19.  $package->InitClass($widget);
  20.  my $leaf = $package->Tk_image;
  21.  my $obj = $widget->Tk::image('create',$leaf,@_);
  22.  return bless $obj,$package;
  23. }
  24.  
  25. sub Install
  26. {
  27.  # Dynamically loaded image types can install standard images here
  28.  my ($class,$mw) = @_;
  29. }
  30.  
  31. sub ClassInit
  32. {
  33.  # Carry out class bindings (or whatever)
  34.  my ($package,$mw) = @_;
  35.  return $package;
  36. }
  37.  
  38. require Tk::Submethods;
  39.  
  40. Direct Tk::Submethods ('image' => [qw(delete width height type)]);
  41.  
  42. sub Tk::Widget::imageNames
  43. {
  44.  my $w = shift;
  45.  $w->image('names',@_);
  46. }
  47.  
  48. sub Tk::Widget::imageTypes
  49. {
  50.  my $w = shift;
  51.  map("\u$_",$w->image('types',@_));
  52. }
  53.  
  54. sub Construct
  55. {
  56.  my ($base,$name) = @_;
  57.  my $class = (caller(0))[0];
  58.  
  59.  # Hack for broken ->isa in perl5.6.0
  60.  delete ${"$class\::"}{'::ISA::CACHE::'} if $] == 5.006;
  61.  
  62.  *{"Tk::Widget::$name"}  = sub { $class->new(@_) };
  63. }
  64.  
  65. # This is here to prevent AUTOLOAD trying to find it.
  66. sub DESTROY
  67. {
  68.  my $i = shift;
  69.  # maybe do image delete ???
  70. }
  71.  
  72.  
  73. 1;
  74.